home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / BOXMENU.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-11  |  10.7 KB  |  287 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
  8.    DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
  9.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  10.    DECLARE SUB Delay18th (BYVAL WaitTime%)
  11.    DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  12.    DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  13.    DECLARE FUNCTION GetCRT2% ()
  14.    DECLARE FUNCTION GetEGA2% ()
  15.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  16.    DECLARE SUB GetMouseLoc (Row%, Column%)
  17.    DECLARE FUNCTION GetVGA2% ()
  18.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  19.    DECLARE SUB MMButton (LeftB%, RightB%)
  20.    DECLARE SUB MMCursorOff ()
  21.    DECLARE SUB MMCursorOn ()
  22.    DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
  23.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  24.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  25.  
  26. SUB BoxMenu (Mouse%, PickList$(), TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Result%)
  27.  
  28.    CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
  29.    IF Visible% THEN LOCATE , , 0
  30.  
  31.    LastItem% = 0
  32.    Columns% = 0
  33.    t1% = UBOUND(PickList$, 1)
  34.    FOR tmp% = t1% TO 1 STEP -1
  35.       t2% = LEN(PickList$(tmp%))
  36.       IF t2% THEN
  37.          IF LastItem% = 0 THEN LastItem% = tmp%
  38.          IF Columns% < t2% THEN Columns% = t2%
  39.       END IF
  40.    NEXT
  41.    IF LastItem% THEN
  42.       Columns% = Columns% + 2
  43.       IF Columns% > 75 THEN Columns% = 75
  44.    ELSE
  45.       Columns% = 14
  46.    END IF
  47.  
  48.    GetVidMode VMode%, Cols%, Page%          ' use active display page
  49.  
  50.    IF GetCRT2% THEN                         ' use fast display unless CGA
  51.       IF GetEGA2% OR GetVGA2% THEN
  52.          Fast% = -1
  53.       ELSE
  54.          Fast% = 0
  55.       END IF
  56.    ELSE
  57.       Fast% = -1
  58.    END IF
  59.  
  60.    RightCol% = LeftCol% + Columns% - 1      ' set right column
  61.    Rows% = BottomRow% - TopRow% + 1         ' and number of rows
  62.  
  63.    IF Shade% THEN
  64.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
  65.    ELSE
  66.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
  67.    END IF
  68.    DIM SavedScreen%(Words%)
  69.  
  70.    TopRec% = 1
  71.    HiliteRow% = 1
  72.  
  73.    '--- save the screen
  74.    IF Mouse% THEN MMCursorOff
  75.    DSeg% = VARSEG(SavedScreen%(1))
  76.    DOfs% = VARPTR(SavedScreen%(1))
  77.    IF Shade% THEN
  78.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  79.    ELSE
  80.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  81.    END IF
  82.  
  83.    UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
  84.    WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
  85.    IF Mouse% THEN MMCursorOn
  86.    GOSUB DisplayItems
  87.  
  88.    DO
  89.       '--- get input from appropriate device(s)
  90.       IF LeftButton% THEN Delay18th 1
  91.       DO
  92.          IF Mouse% THEN MMButton LeftButton%, RightButton%
  93.          IF LeftButton% = 0 AND RightButton% = 0 THEN
  94.             BIOSInkey AsciiCode%, ScanCode%
  95.          END IF
  96.       LOOP UNTIL LeftButton% OR RightButton% OR AsciiCode% OR ScanCode%
  97.       '--- handle mouse input, if any
  98.       IF Mouse% THEN
  99.          IF RightButton% THEN
  100.             AsciiCode% = 27
  101.          ELSEIF (LastItem% < 1) AND LeftButton% THEN
  102.             AsciiCode% = 27
  103.          ELSEIF LeftButton% THEN
  104.             GetMouseLoc MouseRow%, MouseCol%
  105.             IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
  106.                IF MouseCol% = RightCol% + 1 THEN
  107.                   tmp% = SCREEN(MouseRow%, MouseCol%)
  108.                   IF tmp% = 24 THEN
  109.                      ' convert to ^E (same as up arrow)
  110.                      AsciiCode% = 5
  111.                   ELSEIF tmp% = 25 THEN
  112.                      ' convert to ^X (same as down arrow)
  113.                      AsciiCode% = 24
  114.                   END IF
  115.                ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
  116.                   IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
  117.                      HiLiteRow% = MouseRow% - TopRow% + 1
  118.                      AsciiCode% = 13
  119.                   END IF
  120.                END IF
  121.             END IF
  122.          END IF
  123.       END IF
  124.       '--- handle keyboard input, if any
  125.       IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
  126.          IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
  127.             GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
  128.             SELECT CASE AsciiCode%
  129.                CASE 3                     ' ^QC converts to ^<PgDn>
  130.                   AsciiCode% = 0
  131.                   ScanCode% = 118
  132.                CASE 18                    ' ^QR converts to ^<PgUp>
  133.                   AsciiCode% = 0
  134.                   ScanCode% = 132
  135.                CASE ELSE
  136.                   AsciiCode% = 0
  137.                   ScanCode% = 0
  138.             END SELECT
  139.          END IF
  140.          IF AsciiCode% = 0 AND ScanCode% = 71 THEN
  141.             ' <HOME>
  142.             IF HiliteRow% > 1 THEN
  143.                HiliteRow% = 1
  144.                GOSUB DisplayItems
  145.             END IF
  146.          ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
  147.             ' <END>
  148.             IF TopRec% + Rows% > LastItem% THEN
  149.                HiliteRow% = LastItem% - TopRec% + 1
  150.             ELSE
  151.                HiliteRow% = Rows%
  152.             END IF
  153.             GOSUB DisplayItems
  154.          ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
  155.             ' <CTRL><PGDN>
  156.             TopRec% = LastItem% - Rows% + 1
  157.             IF TopRec% < 1 THEN TopRec% = 1
  158.             IF TopRec% + Rows% > LastItem% THEN
  159.                HiliteRow% = LastItem% - TopRec% + 1
  160.             ELSE
  161.                HiliteRow% = Rows%
  162.             END IF
  163.             GOSUB DisplayItems
  164.          ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
  165.             ' <CTRL><PGUP>
  166.             IF TopRec% > 1 OR HiliteRow% > 1 THEN
  167.                TopRec% = 1
  168.                HiliteRow% = 1
  169.                GOSUB DisplayItems
  170.             END IF
  171.          ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
  172.             ' ^C or PgDn
  173.             IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
  174.                TopRec% = TopRec% + Rows%
  175.             ELSE
  176.                TopRec% = LastItem% - Rows% + 1
  177.                IF TopRec% < 1 THEN TopRec% = 1
  178.             END IF
  179.             IF TopRec% > LastItem% THEN TopRec% = LastItem%
  180.             IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
  181.                HiliteRow% = LastItem% - TopRec% + 1
  182.             END IF
  183.             GOSUB DisplayItems
  184.          ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
  185.             ' ^E or up arrow
  186.             IF HiliteRow% > 1 OR TopRec% > 1 THEN
  187.                IF HiliteRow% > 1 THEN
  188.                   HiliteRow% = HiliteRow% - 1
  189.                ELSE
  190.                   TopRec% = TopRec% - 1
  191.                END IF
  192.                GOSUB DisplayItems
  193.             END IF
  194.          ELSEIF AsciiCode% = 13 THEN
  195.             ' <CR>
  196.             IF LastItem% < 1 THEN
  197.                AsciiCode% = 27
  198.                LemmeOuttaHere% = -1
  199.             ELSE
  200.                PickedOne% = (TopRec% + HiLiteRow% - 1 <= LastItem%)
  201.             END IF
  202.          ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
  203.             ' ^X or down arrow
  204.             IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastItem% THEN
  205.                HiliteRow% = HiliteRow% + 1
  206.                GOSUB DisplayItems
  207.             ELSE
  208.                IF TopRec% + Rows% - 1 < LastItem% THEN
  209.                   TopRec% = TopRec% + 1
  210.                   GOSUB DisplayItems
  211.                END IF
  212.             END IF
  213.          ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
  214.             ' ^R or PgUp
  215.             IF TopRec% > Rows% THEN
  216.                TopRec% = TopRec% - Rows%
  217.                GOSUB DisplayItems
  218.             ELSE
  219.                IF TopRec% > 1 THEN
  220.                   TopRec% = 1
  221.                   GOSUB DisplayItems
  222.                END IF
  223.             END IF
  224.          ELSEIF AsciiCode% = 27 THEN
  225.             ' <ESC>
  226.             LemmeOuttaHere% = -1
  227.          END IF
  228.       END IF
  229.    LOOP UNTIL PickedOne% OR LemmeOuttaHere%
  230.  
  231.    IF PickedOne% THEN
  232.       Result% = TopRec% + HiLiteRow% - 1
  233.    ELSE
  234.       Result% = 0
  235.    END IF
  236.  
  237.    '--- restore the screen
  238.    IF Mouse% THEN MMCursorOff
  239.    DSeg% = VARSEG(SavedScreen%(1))
  240.    DOfs% = VARPTR(SavedScreen%(1))
  241.    IF Shade% THEN
  242.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  243.    ELSE
  244.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  245.    END IF
  246.    IF Mouse% THEN MMCursorOn
  247.    IF Visible% THEN LOCATE , , 1
  248.  
  249.    EXIT SUB
  250.  
  251. DisplayItems:
  252.    IF Mouse% THEN MMCursorOff
  253.    IF LastItem% < 1 THEN
  254.       XQPrint "...no items...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
  255.    ELSE
  256.       ' update scroll bar as needed
  257.       IF Rows% < LastItem% THEN
  258.          FOR Row% = TopRow% TO BottomRow%
  259.             XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
  260.          NEXT
  261.          IF TopRec% > 1 AND Rows% > 1 THEN
  262.             XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  263.          END IF
  264.          IF TopRec% + Rows% - 1 < LastItem% AND Rows% > 0 THEN
  265.             XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  266.          END IF
  267.       END IF
  268.       ' update item list
  269.       FOR Row% = 1 TO Rows%
  270.          tmp% = TopRec% + Row% - 1
  271.          IF tmp% <= LastItem% THEN
  272.             St$ = LEFT$(" " + LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns%)
  273.          ELSE
  274.             St$ = SPACE$(Columns%)
  275.          END IF
  276.          IF Row% = HiliteRow% THEN
  277.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
  278.          ELSE
  279.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, ItemListAttr%, Page%, Fast%
  280.          END IF
  281.       NEXT
  282.    END IF
  283.    IF Mouse% THEN MMCursorOn
  284.    RETURN
  285.  
  286. END SUB
  287.